      SUBROUTINE ASYREG(A,NA,B,NB,H,NH,Q,NQ,R,NR,F,NF,P,NP,IDENT,DISC,N
     1EWT,STABLE,FNULL,ALPHA,IOP,DUMMY)
C 
C   PURPOSE:
C      Solve either the continuous or discrete time-invariant asymp-
C      totic linear optimal output regulator problem with noise-free
C      measurements.  ASYREG does not evaluate the optimal values of
C      the performance criteria.  Therefore, no V data are input.  The
C      option of solving the appropriate steady-state Riccati equation
C      using either of the subroutines DISREG, CNTREG, or RICNWT is
C      provided.
C 
C   REFERENCES:
C      Kwakernaak, Huibert; and Sivan, Raphael: Linear Optimal Control
C        Systems.  John Wiley & Sons, Inc., c. 1972.
C 
C   Subroutines employed by ASYREG: ADD, CNTREG, CSTAB, DISREG, DSTAB,
C      EIGEN, EQUATE, JUXTC, LNCNT, MULT, PRNT, RICNWT, SCALE, SUBT,
C      TESTST, TRANP
C   Subroutines employing ASYREG: ASYFIL, EXMDFL, IMMDFL
C 
      IMPLICIT REAL*8 (A-H,O-Z)
      DIMENSION A(1),B(1),H(1),Q(1),R(1),F(1),P(1),DUMMY(1)
      DIMENSION NA(2),NB(2),NH(2),NQ(2),NR(2),NF(2),NP(2),IOP(5),IOPT(3)
     1,NDUM1(2),NDUM2(2),NDUM3(2)
      LOGICAL IDENT,DISC,NEWT,STABLE,FNULL,SING
C 
      N = NA(1)**2
      N1= N+1
      IOPTT=0
C 
      IF ( .NOT. NEWT ) GO TO 600
      IF( STABLE )  GO TO 500
      IF ( FNULL ) GO TO 100
      CALL MULT(B,NB,F,NF,DUMMY,NA)
      CALL SUBT(A,NA,DUMMY,NA,DUMMY,NA)
      CALL TESTST(DUMMY,NA,ALPHA,DISC,STABLE,IOPTT,DUMMY(N1))
      GO TO 200
C 
  100 CONTINUE
      CALL TESTST(A,NA,ALPHA,DISC,STABLE,IOPTT,DUMMY)
C 
  200 CONTINUE
      IF( STABLE ) GO TO 500
      IF( DISC ) GO TO 230
      J = -NA(1)
      NAX = NA(1)
      DO 210 I =1,NAX
      J = J + NAX +1
      A(J) = A(J)-ALPHA
  210 CONTINUE
      SCLE = 3.
      IOPT(1)=IOP(1)
      IOPT(2) = 1
      IOPT(3)=1
      CALL CSTAB(A,NA,B,NB,F,NF,IOPT,SCLE,DUMMY)
      J = -NA(1)
      DO 220 I=1,NAX
      J = J + NAX + 1
      A(J) = A(J) + ALPHA
  220 CONTINUE
  225 CONTINUE
      CALL MULT(B,NB,F,NF,DUMMY,NA)
      CALL SUBT(A,NA,DUMMY,NA,DUMMY,NA)
      CALL TESTST(DUMMY,NA,ALPHA,DISC,STABLE,IOPTT,DUMMY(N1))
      GO TO 300
C 
  230 CONTINUE
      J = 2*NA(1) + 1
      IF( .NOT. FNULL )  J = J + N
      SING = .FALSE.
      IF( DUMMY(J) .EQ. 0.0 )  SING = .TRUE.
      IOPT(1) = IOP(1)
      IOPT(2) = 1
      DSCLE = 0.5
      ALPHAT = 1./ALPHA
      CALL SCALE(A,NA,A,NA,ALPHAT)
      CALL SCALE(B,NB,B,NB,ALPHAT)
      CALL DSTAB(A,NA,B,NB,F,NF,SING,IOPT,DSCLE,DUMMY)
      CALL SCALE(A,NA,A,NA,ALPHA)
      CALL SCALE(B,NB,B,NB,ALPHA)
      GO TO 225
C 
  300 CONTINUE
      IF( STABLE) GO TO 400
      CALL LNCNT(5)
      IF( DISC ) GO TO 330
      WRITE(6,310) ALPHA
  310 FORMAT(//' IN ASYREG, CSTAB HAS FAILED TO FIND A STABILIZING GAIN
     1 MATRIX (F) RELATIVE TO '/' ALPHA = ',D16.8/)
      RETURN
  330 CONTINUE
      WRITE(6,340) ALPHA
  340 FORMAT(//' IN ASYREG, DSTAB HAS FAILED TO FIND A STABILIZING GAIN
     1 MATRIX (F) RELATIVE TO '/' ALPHA = ',D16.8/)
      RETURN
C 
  400 CONTINUE
      FNULL = .FALSE.
C 
  500 CONTINUE
      CALL RICNWT(A,NA,B,NB,H,NH,Q,NQ,R,NR,F,NF,P,NP,IOP,IDENT,DISC,FNU
     1LL,DUMMY)
      GO TO 750
C 
  600 CONTINUE
      IF( DISC ) GO TO 700
      NW = 4*N + 1
      NLAM = NW + 4*N
      NDUM = NLAM + N
      IOP(3) = 1
      CALL CNTREG(A,NA,B,NB,H,NH,Q,NQ,R,NR,DUMMY,DUMMY(NW),DUMMY(NLAM),
     1S,F,NF,P,NP,T,IOP,IDENT,DUMMY(NDUM))
      GO TO 750
  700 CONTINUE
      CALL DISREG(A,NA,B,NB,H,NH,Q,NQ,R,NR,F,NF,P,NP,IOP,IDENT,DUMMY)
C 
  750 CONTINUE
C 
      IF( IOP(4) .EQ. 0 ) GO TO 1100
C 
      N2= N1 + N
      N3= N2 + N
C 
      IF( DISC ) GO TO 800
      CALL MULT(P,NP,B,NB,DUMMY,NB)
      CALL MULT(DUMMY,NB,F,NF,DUMMY(N1),NP)
      CALL TRANP(DUMMY(N1),NP,DUMMY,NP)
      CALL ADD(DUMMY,NP,DUMMY(N1),NP,DUMMY,NP)
      CALL SCALE(DUMMY,NP,DUMMY,NP,0.5D0)
      CALL SUBT(Q,NQ,DUMMY,NP,DUMMY,NP)
      CALL MULT(P,NP,A,NA,DUMMY(N1),NP)
      CALL ADD(DUMMY,NP,DUMMY(N1),NP,DUMMY,NP)
      CALL TRANP(DUMMY(N1),NP,DUMMY(N2),NP)
      CALL ADD(DUMMY,NP,DUMMY(N2),NP,DUMMY,NP)
      GO TO 900
C 
  800 CONTINUE
      CALL MULT(R,NR,F,NF,DUMMY,NF)
      CALL TRANP(F,NF,DUMMY(N1),NB)
      CALL MULT(DUMMY(N1),NB,DUMMY,NF,DUMMY(N2),NA)
      CALL ADD(DUMMY(N2),NA,Q,NQ,DUMMY,NA)
      CALL MULT(B,NB,F,NF,DUMMY(N1),NA)
      CALL SUBT(A,NA,DUMMY(N1),NA,DUMMY(N1),NA)
      CALL MULT(P,NP,DUMMY(N1),NA,DUMMY(N2),NA)
      CALL TRANP(DUMMY(N1),NA,DUMMY(N3),NA)
      CALL MULT(DUMMY(N3),NA,DUMMY(N2),NA,DUMMY(N1),NA)
      CALL ADD(DUMMY,NA,DUMMY(N1),NA,DUMMY,NA)
      CALL SUBT(P,NP,DUMMY,NA,DUMMY,NA)
C 
  900 CONTINUE
      CALL LNCNT(4)
      WRITE(6,1000)
 1000 FORMAT(//' RESIDUAL ERROR IN RICCATI EQUATION '/)
      CALL PRNT(DUMMY,NP,'EROR',1)
C 
 1100 CONTINUE
      N2= N1+NA(1)
      N3= N2+NA(1)
      ISV = 0
      CALL EQUATE(P,NP,DUMMY,NP)
      CALL EIGEN(NA(1),NA(1),DUMMY,DUMMY(N1),DUMMY(N2),ISV,ISV,V,DUMMY(N
     13),IERR)
      NEVL = NA(1)
      IF( IERR .EQ. 0) GO TO 1300
      NEVL=NA(1)-IERR
      CALL LNCNT(4)
      WRITE(6,1200) IERR
 1200 FORMAT(//' IN ASYREG, THE ',I5 ,' EIGENVALUE OF P  HAS NOT BEEN C
     1OMPUTED AFTER 30 ITERATIONS '/)
C 
 1300 CONTINUE
      NDUM1(1) = NEVL
      NDUM1(2) = 1
      CALL EQUATE(DUMMY(N1),NDUM1,DUMMY,NDUM1)
      N1 = NDUM1(1) +1
      CALL MULT(B,NB,F,NF,DUMMY(N1),NA)
      CALL SUBT(A,NA,DUMMY(N1),NA,DUMMY(N1),NA)
      N2 = N1+N
      CALL EQUATE(DUMMY(N1),NA,DUMMY(N2),NA)
      N3=N2+N
      N4=N3+NA(1)
      N5=N4+NA(1)
      CALL EIGEN(NA(1),NA(1),DUMMY(N2),DUMMY(N3),DUMMY(N4),ISV,ISV,V,DUM
     1MY(N5),IERR)
      NEVL = NA(1)
      IF( IERR .EQ. 0 ) GO TO 1500
      NEVL=NA(1)-IERR
      CALL LNCNT(4)
      WRITE(6,1400) IERR
 1400 FORMAT(//' IN ASYREG, THE ',I5,' EIGENVALUE OF A-BF HAS NOT BEEN
     1COMPUTED AFTER 30 ITERATIONS'/)
C 
 1500 CONTINUE
      NDUM2(1) = NEVL
      NDUM2(2) = 1
      CALL JUXTC(DUMMY(N3),NDUM2,DUMMY(N4),NDUM2,DUMMY(N2),NDUM3)
C 
      IF ( IOP(5) .EQ. 0 ) RETURN
C 
      CALL LNCNT(4)
      WRITE(6,1600)
 1600 FORMAT(//' EIGENVALUES OF P '/)
      CALL PRNT(DUMMY,NDUM1,'EVLP',1)
      CALL LNCNT(4)
      WRITE(6,1700)
 1700 FORMAT(//' CLOSED-LOOP RESPONSE MATRIX A-BF '/)
      CALL PRNT(DUMMY(N1),NA,'A-BF',1)
      CALL LNCNT(3)
      WRITE(6,1800)
 1800 FORMAT(//' EIGENVALUES OF A-BF')
      CALL PRNT(DUMMY(N2),NDUM3,0,3)
C 
      RETURN
      END
